perm filename ANS1.NEW[1,JRA] blob
sn#005897 filedate 1972-09-22 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP ANS1
00400 (LAMBDA(L)
00500 (PROG (Z Z2 Z3 Z4 Z5 L1 N)
00600 (SETQ N 1)
00700 (SETQ L (LIST (CONS (CONS NIL (CONS NIL (CONS 0 L))) (QUOTE ((ANS (A)))))))
00800 B (SETQ Z2 (CAAR L))
00900 (SETQ Z3 (LENGTH (CDAR L)))
01000 (COND ((NULL (CADR Z2)) (SETQ Z4 NIL))
01100 (T
01200 (SETQ Z4
01300 (PROG (Z Z1 N)
01400 (SETQ N 0)
01500 (SETQ Z1 (CDAR L))
01600 (SETQ Z (CADR Z2))
01700 A (COND ((EQ Z Z1) (RETURN N)))
01800 (SETQ Z1 (CDR Z1))
01900 (SETQ N (ADD1 N))
02000 (GO A)))))
02100 (SETQ Z (CDDDR Z2))
02200 (COND ((NUMBERP (CDR Z))
02300 (COND ((NOT (NUMBERP (CAR Z))) (RPLACD (LAST L) (LIST (CAAR Z) (CDAR Z)))
02400 (SETQ Z5 (CONS N (ADD1 N)))
02500 (SETQ N (ADD1 (ADD1 N))))
02600 (T (SETQ Z5(LIST Z)))))
02700 (T (RPLACD (LAST L) (LIST (CAR Z) (CDR Z)))
02800 (SETQ Z5 (CONS N (ADD1 N)))
02900 (SETQ N (ADD1 (ADD1 N)))))
03000 (SETQ Z (CONS Z3 (CONS Z4 (CONS 0 Z5))))
03100 (SETQ L1 (CONS (CONS Z (CDAR L)) L1))
03200 (SETQ L (CDR L))
03300 (COND (L (GO B)))
03400 (RETURN L1)))
03500 EXPR)